object frmCleanSourceMain: TfrmCleanSourceMain
  Left = 93
  Top = 173
  Width = 793
  Height = 602
  Caption = #20195#30721#28165#29702#21161#25163
  Color = clBtnFace
  Font.Charset = GB2312_CHARSET
  Font.Color = clWindowText
  Font.Height = -12
  Font.Name = #23435#20307
  Font.Style = []
  OldCreateOrder = False
  OnClose = FormClose
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 12
  object pnl1: TPanel
    Left = 0
    Top = 0
    Width = 785
    Height = 121
    Align = alTop
    BevelOuter = bvNone
    Caption = 'pnl1'
    TabOrder = 0
    object lbl1: TLabel
      Left = 24
      Top = 28
      Width = 60
      Height = 12
      Caption = #36716#25442#23545#35937#65306
    end
    object lbl2: TLabel
      Left = 24
      Top = 60
      Width = 60
      Height = 12
      Caption = #30446#26631#30446#24405#65306
    end
    object edtSourcePath: TEdit
      Left = 96
      Top = 24
      Width = 433
      Height = 20
      TabOrder = 0
      Text = 'test.pas'
    end
    object btnClean: TButton
      Left = 536
      Top = 24
      Width = 75
      Height = 25
      Caption = #28165#29702
      TabOrder = 1
      OnClick = btnCleanClick
    end
    object edtDestPath: TEdit
      Left = 96
      Top = 56
      Width = 433
      Height = 20
      TabOrder = 2
      Text = 'Newtest.pas'
    end
    object btnGetFlags: TButton
      Left = 624
      Top = 24
      Width = 75
      Height = 25
      Caption = #33719#21462#26631#31614
      TabOrder = 3
      OnClick = btnGetFlagsClick
    end
    object Button1: TButton
      Left = 696
      Top = 56
      Width = 75
      Height = 25
      Caption = 'Button1'
      TabOrder = 4
      OnClick = Button1Click
    end
    object Edit1: TEdit
      Left = 96
      Top = 88
      Width = 473
      Height = 20
      TabOrder = 5
      Text = 
        'D:\MyDoc\Dev\Temp\unidac350src\Source\UniProviders\SQLServer\OLE' +
        'DBAccessUni.pas'
    end
    object Button2: TButton
      Left = 576
      Top = 88
      Width = 75
      Height = 25
      Caption = 'Button2'
      TabOrder = 6
      OnClick = btn122Click
    end
    object Button3: TButton
      Left = 656
      Top = 88
      Width = 75
      Height = 25
      Caption = 'Button3'
      TabOrder = 7
      OnClick = Button3Click
    end
  end
  object pnl2: TPanel
    Left = 0
    Top = 121
    Width = 785
    Height = 447
    Align = alClient
    BevelOuter = bvNone
    Caption = 'pnl2'
    TabOrder = 1
    object spl1: TSplitter
      Left = 337
      Top = 0
      Height = 447
    end
    object pnl3: TPanel
      Left = 0
      Top = 0
      Width = 337
      Height = 447
      Align = alLeft
      BevelOuter = bvNone
      Caption = 'pnl3'
      TabOrder = 0
      object mmo3: TMemo
        Left = 145
        Top = 0
        Width = 192
        Height = 447
        Align = alClient
        BorderStyle = bsNone
        ScrollBars = ssBoth
        TabOrder = 0
        WordWrap = False
      end
      object pnl5: TPanel
        Left = 0
        Top = 0
        Width = 145
        Height = 447
        Align = alLeft
        Caption = 'pnl5'
        TabOrder = 1
        object grp1: TGroupBox
          Left = 1
          Top = 1
          Width = 143
          Height = 239
          Align = alClient
          Caption = #28165#38500#24320#20851#20869#23481
          TabOrder = 0
          object mmo4: TMemo
            Left = 2
            Top = 14
            Width = 139
            Height = 223
            Align = alClient
            BorderStyle = bsNone
            ScrollBars = ssBoth
            TabOrder = 0
            WordWrap = False
          end
        end
        object grp2: TGroupBox
          Left = 1
          Top = 240
          Width = 143
          Height = 206
          Align = alBottom
          Caption = #21435#38500#24320#20851
          TabOrder = 1
          object mmo5: TMemo
            Left = 2
            Top = 14
            Width = 139
            Height = 190
            Align = alClient
            BorderStyle = bsNone
            ScrollBars = ssBoth
            TabOrder = 0
            WordWrap = False
          end
        end
      end
    end
    object pnl4: TPanel
      Left = 340
      Top = 0
      Width = 445
      Height = 447
      Align = alClient
      BevelOuter = bvNone
      Caption = 'pnl4'
      TabOrder = 1
      object spl2: TSplitter
        Left = 0
        Top = 176
        Width = 445
        Height = 4
        Cursor = crVSplit
        Align = alTop
      end
      object mmo1: TMemo
        Left = 0
        Top = 0
        Width = 445
        Height = 176
        Align = alTop
        BorderStyle = bsNone
        Lines.Strings = (
          '//MMWIN:MEMBERSCOPY'
          'unit _MM_Copy_Buffer_;'
          ''
          'interface'
          ''
          'type'
          '  TOLEDBRecordSet = class(TCRRecordSet)'
          '  protected'
          
            '    function Fetch(FetchBack: boolean = False): boolean; overrid' +
            'e;'
          '  end;'
          ''
          ''
          'implementation'
          ''
          
            'function TOLEDBRecordSet.Fetch(FetchBack: boolean = False): bool' +
            'ean;'
          'var'
          '  OldFetchFromBookmark: boolean;'
          ''
          '  procedure GetDataFromRow(const Row: hRow; const pRec: IntPtr);'
          
            '    procedure PrepareConvertableFields; // After get data from O' +
            'LEDB'
          '    var'
          '      i: integer;'
          '      pValue: IntPtr;'
          ''
          '      OleDbBuf: IntPtr;'
          '      Field: TOLEDBFieldDesc;'
          ''
          '    {$IFDEF VER6P}'
          '    {$IFOPT C+}'
          '      FieldStatus: DWORD;'
          '    {$ENDIF}'
          '    {$IFDEF CLR}'
          '      BcdOut: TBcd;'
          '      g: TGuid;'
          '      p: IntPtr;'
          '      j: integer;'
          '      BcdBuf: TBytes;'
          '      s: AnsiString;'
          '      DBNum: TDBNumeric;'
          '      Data: TBytes;'
          '    {$ELSE}'
          '      FieldLength, FieldScale: word;'
          '    {$IFDEF VER9}'
          '      Delta: word;'
          '    {$ENDIF}'
          '    {$ENDIF}'
          '      Bcd: TBcd;'
          '    {$ENDIF}'
          '      DBTimeStamp: TDBTimeStamp;'
          '      dt: TDateTime;'
          '      d: double;'
          '      CurrTimestamp: Int64;'
          '      TimeStamp: TTimeStamp;'
          '    begin'
          '      for i := 0 to Fields.Count - 1 do begin'
          '        Field := TOLEDBFieldDesc(Fields[i]);'
          '        if Field.FieldDescKind <> fdkData then'
          '          SetNull(i + 1, pRec, True)'
          '        else'
          '        begin'
          '          pValue := IntPtr(Integer(pRec) + Field.Offset);'
          ''
          '          // Get max Timestamp value for RefreshQuick'
          
            '          if Field.IsTimestamp and (Field.TableInfo <> nil) then' +
            ' begin'
          '          {$IFDEF CLR}'
          '            SetLength(Data, SizeOf(Int64));'
          '            Marshal.Copy(pValue, Data, 0, SizeOf(Int64));'
          '            System.Array.Reverse(Data, 0, SizeOf(Int64));'
          '            CurrTimestamp := BitConverter.ToInt64(Data, 0);'
          '          {$ELSE}'
          '            CurrTimestamp := Marshal.ReadInt64(pValue);'
          '            Reverse8(@CurrTimestamp);'
          '          {$ENDIF}'
          
            '            if {$IFDEF VER7P}UInt64{$ENDIF}(TOLEDBTableInfo(Fiel' +
            'd.TableInfo).FMaxTimestamp) < {$IFDEF VER7P}UInt64{$ENDIF}(CurrT' +
            'imestamp) then'
          
            '              TOLEDBTableInfo(Field.TableInfo).FMaxTimestamp := ' +
            'CurrTimestamp;'
          '          end;'
          ''
          '          OleDbBuf := nil;'
          '          try'
          '            case Field.DataType of'
          '              dtVarBytes:'
          
            '                Marshal.WriteInt16(pValue, SmallInt(UINT(Marshal' +
            '.ReadInt32(pValue, sizeof(word) + Field.Length))));'
          '            {$IFDEF VER6P}'
          '            {$IFNDEF FPC}'
          '              dtFmtBCD:'
          '                if not GetNull(i + 1, pRec) then begin'
          '                {$IFOPT C+}'
          '                  FieldStatus := GetStatus(i, pRec);'
          
            '                  Assert(FieldStatus = DBSTATUS_S_OK, Field.Name' +
            ' +  '#39': FieldStatus = $'#39' + IntToHex(FieldStatus, 8){ + '#39', Value =' +
            ' '#39' + Marshal.PtrToStringAnsi(pValue)});'
          '                {$ENDIF}'
          '                {$IFDEF CLR}'
          
            '                  DBNum := TDBNumeric(Marshal.PtrToStructure(pVa' +
            'lue, TypeOf(TDBNumeric)));'
          '                  Bcd := DBNumericToBCD(DBNum);'
          
            '                  NormalizeBcd(Bcd, BcdOut, Field.Length, Field.' +
            'Scale);'
          ''
          '                  // Copied from TBcd.ToBytes'
          '                  SetLength(BcdBuf, 34);'
          '                  BcdBuf[0] := BcdOut.Precision;'
          '                  BcdBuf[1] := BcdOut.SignSpecialPlaces;'
          '                  for j := 0 to 31 do'
          '                    BcdBuf[j + 2] := BcdOut.Fraction[j];'
          '                  Marshal.Copy(BcdBuf, 0, pValue, 34);'
          '                {$ELSE}'
          '                  Bcd := DBNumericToBCD(TDBNumeric(pValue^));'
          ''
          '                  FieldLength := Field.Length;'
          '                  FieldScale := Field.Scale;'
          '                {$IFDEF VER9} // Delphi 9 NormalizeBcd Bug'
          '                  Delta := FieldLength - FieldScale;'
          '                  if Delta > 34 then begin'
          '                    Delta := 34;'
          '                    FieldLength := FieldScale + Delta;'
          '                  end;'
          '                {$ENDIF}'
          
            '                  NormalizeBcd(Bcd, PBcd(pValue)^, FieldLength, ' +
            'FieldScale);'
          '                {$ENDIF}'
          '                end;'
          '            {$ENDIF}'
          '            {$ENDIF}'
          '            {$IFDEF VER5P}'
          '              dtGuid:'
          '                if not GetNull(i + 1, pRec) then'
          '                {$IFDEF CLR}'
          '                begin'
          
            '                  g := TGUID(Marshal.PtrToStructure(pValue, Type' +
            'Of(TGUID)));'
          '                  s := '#39'{'#39' + GUIDToString(g) + '#39'}'#39';'
          '                  p := Marshal.StringToHGlobalAnsi(s);'
          '                  try'
          '                    StrLCopy(pValue, p, 38);'
          '                  finally'
          '                    Marshal.FreeHGlobal(p);'
          '                  end;'
          '                end;'
          '                {$ELSE}'
          
            '                  StrLCopy(PAChar(pValue), PAChar(@AnsiString(GU' +
            'IDToString(PGUID(pValue)^))[1]), 38);'
          '                {$ENDIF}'
          '            {$ENDIF}'
          '              dtTime:'
          '                if not GetNull(i + 1, pRec) then begin'
          '                {$IFDEF CLR}'
          
            '                  dt := BitConverter.Int64BitsToDouble(Marshal.R' +
            'eadInt64(pValue));'
          '                {$ELSE}'
          '                  dt := PDateTime(pValue)^;'
          '                {$ENDIF}'
          '                  TimeStamp := DateTimeToTimeStamp(dt);'
          '                  TimeStamp.Date := DateDelta;'
          '                  dt := TimeStampToDateTime(TimeStamp);'
          
            '                  Marshal.WriteInt64(pValue, BitConverter.Double' +
            'ToInt64Bits(Double(dt)));'
          '                end;'
          '              dtDateTime:'
          
            '                if (Provider = prCompact) and (FCursorType <> ct' +
            'BaseTable) and (not GetNull(i + 1, pRec)) then begin'
          '                {$IFDEF CLR}'
          
            '                  DBTimeStamp := TDBTimeStamp(Marshal.PtrToStruc' +
            'ture(pValue, TypeOf(TDBTimeStamp)));'
          '                {$ELSE}'
          '                  DBTimeStamp := PDBTimeStamp(pValue)^;'
          '                {$ENDIF}'
          
            '                  dt := {$IFNDEF CLR}MemUtils.{$ENDIF}EncodeDate' +
            'Time(DBTimeStamp.year, DBTimeStamp.month, DBTimeStamp.day, DBTim' +
            'eStamp.hour, DBTimeStamp.minute, DBTimeStamp.second, DBTimeStamp' +
            '.fraction div 1000000{Billionths of a second to milliseconds});'
          
            '                  Marshal.WriteInt64(pValue, BitConverter.Double' +
            'ToInt64Bits(Double(dt)));'
          '                end;'
          '              dtCurrency:'
          
            '                if (Provider = prCompact) and (FCursorType <> ct' +
            'BaseTable) then begin'
          '                {$IFDEF CLR}'
          '                  d := Marshal.ReadInt64(pValue);'
          '                  d := d / 10000;'
          '                {$ELSE}'
          '                  d := Currency(pValue^);'
          '                {$ENDIF}'
          
            '                  Marshal.WriteInt64(pValue, BitConverter.Double' +
            'ToInt64Bits(d));'
          '                end;'
          '              dtFloat:'
          
            '                if (not GetNull(i + 1, pRec)) and (Provider = pr' +
            'Compact) and (FCursorType <> ctBaseTable) then begin'
          '                  if (Field.SubDataType = dtSingle) then begin'
          '                  {$IFDEF CLR}'
          
            '                    BcdBuf := BitConverter.GetBytes(Marshal.Read' +
            'Int64(pValue));'
          '                    d := BitConverter.ToSingle(BcdBuf, 0);'
          '                  {$ELSE}'
          '                    d := Single(pValue^);'
          '                  {$ENDIF}'
          
            '                    Marshal.WriteInt64(pValue, BitConverter.Doub' +
            'leToInt64Bits(d));'
          '                  end'
          '                end;'
          '              dtWord:'
          
            '                if (not GetNull(i + 1, pRec)) and (Provider = pr' +
            'Compact) and (FCursorType <> ctBaseTable) and (Field.SubDataType' +
            ' = dtUInt8) then'
          
            '                  Marshal.WriteByte(IntPtr(Integer(pValue) + 1),' +
            ' 0);'
          '            end;'
          '          finally'
          '            if OleDbBuf <> nil then'
          '              FreeCoMem(OleDbBuf);'
          '          end;'
          '        end;'
          '      end;'
          '    end;'
          ''
          
            '    procedure FetchPlainAccessorBlock(const AccessorBlock: TAcce' +
            'ssorBlock);'
          '    var'
          '      hr: HResult;'
          '      Blob: TBlob;'
          '      Field: TFieldDesc;'
          '      pValue: IntPtr;'
          '      Length: integer;'
          ''
          '    begin'
          '      // Get data from IRowset'
          '      hr := FIRowset.GetData(Row, AccessorBlock.hAcc, pRec);'
          '      Check(hr, AnalyzeFieldsStatus, pRec);'
          ''
          '      // ConvertMemoToBlob;'
          '      if AccessorBlock.BlobFieldNum <> -1 then begin'
          '        Field := Fields[AccessorBlock.BlobFieldNum];'
          '        pValue := IntPtr(Integer(pRec) + Field.Offset);'
          
            '        Length := Marshal.ReadInt32(pRec, Field.Offset + SizeOf(' +
            'IntPtr));'
          '        if FReadOnly then'
          '          Length := 0;'
          '      {$IFDEF HAVE_COMPRESS}'
          '        if Field.DataType = dtBlob then'
          
            '          Blob := TCompressedBlob.Create((Field.SubDataType and ' +
            'dtWide) <> 0)'
          '        else'
          '      {$ENDIF}'
          
            '          Blob := TBlob.Create((Field.SubDataType and dtWide) <>' +
            ' 0);'
          ''
          '        try'
          
            '          if (GetStatus(AccessorBlock.BlobFieldNum, pRec) <> DBS' +
            'TATUS_S_ISNULL) then // Can'#39't use GetNull->GetNullByBlob'
          
            '            ConvertStreamToBlob(pValue, Length, Blob{$IFDEF HAVE' +
            '_COMPRESS}, FCommand.FCompressBlob{$ENDIF},'
          
            '            {$IFDEF LITE}((not dtWide) and Field.SubDataType = d' +
            'tMSXML){$ELSE}(Field.DataType = dtMSXML){$ENDIF});'
          '        finally'
          '          Marshal.WriteInt32(pValue, Integer(Blob.GCHandle));'
          '        end;'
          '      end;'
          '    end;'
          ''
          '  var'
          '    FetchBlockOffset: integer;'
          ''
          
            '    procedure FetchExternalAccessorBlock(const AccessorBlock: TA' +
            'ccessorBlock);'
          '    var'
          '      hr: HResult;'
          '      i, FieldNum: integer;'
          '      Status: DWORD;'
          '      Obj: TSharedObject;'
          '      Blob: TBlob;'
          '      pc: IntPtr;'
          '      pValue, pFetchBlockValue: IntPtr;'
          ''
          '      Field: TFieldDesc;'
          '      l: integer;'
          ''
          '      Size: word;'
          '      HeapBuf: IntPtr;'
          '      t: boolean;'
          '      DBNumeric: TDBNumeric;'
          '      d: double;'
          '    {$IFNDEF CLR}'
          '      c: currency;'
          '    {$ENDIF}'
          '      i64: Int64;'
          ''
          '    begin'
          '      Assert(AccessorBlock.BlobFieldNum = - 1);'
          '      // Get data from IRowset'
          
            '      hr := FIRowset.GetData(Row, AccessorBlock.hAcc, FFetchBloc' +
            'k);'
          ''
          
            '      // Copy status from external buf to pRec. Need to correct ' +
            'work CheckAndAnalyzeFieldsStatus'
          '      for i := 0 to Length(AccessorBlock.FieldNums) - 1 do begin'
          '        FieldNum := AccessorBlock.FieldNums[i];'
          '        Field := Fields[FieldNum];'
          
            '        if IsNeedFetchBlock(Field, ProviderPrimaryVer) and (Fiel' +
            'd.FieldDescKind = fdkData) then begin'
          
            '          Status := DWORD(Marshal.ReadInt32(FFetchBlock, FetchBl' +
            'ockOffset));'
          '          SetStatus(FieldNum, pRec, Status);'
          ''
          
            '          pFetchBlockValue := IntPtr(Integer(FFetchBlock) + Fetc' +
            'hBlockOffset + OLE_DB_INDICATOR_SIZE);'
          '          pValue := IntPtr(Integer(pRec) + Field.Offset);'
          ''
          '          case Field.DataType of'
          '            dtExtString, dtExtWideString: begin'
          '              if GetNull(FieldNum + 1, pRec) then'
          '                Marshal.WriteIntPtr(pValue, nil)'
          '              else'
          '              begin'
          '                if Field.Fixed then'
          '                  t := TrimFixedChar'
          '                else'
          '                  t := TrimVarChar;'
          '                l := Marshal.ReadInt32(pFetchBlockValue);'
          
            '                pFetchBlockValue := IntPtr(Integer(pFetchBlockVa' +
            'lue) + 4);'
          '                if Field.DataType = dtExtString then'
          
            '                  Marshal.WriteIntPtr(pValue, StringHeap.AllocSt' +
            'r(pFetchBlockValue, t, l))'
          '                else'
          
            '                  Marshal.WriteIntPtr(pValue, StringHeap.AllocWi' +
            'deStr(pFetchBlockValue, t, l div 2));'
          '              end;'
          '            end;'
          '            dtExtVarBytes:'
          '              if GetNull(FieldNum + 1, pRec) then'
          '                Marshal.WriteIntPtr(pValue, nil)'
          '              else'
          '              begin'
          
            '                Size := UINT(Marshal.ReadInt32(pFetchBlockValue,' +
            ' MaxNonBlobFieldLen));'
          
            '                HeapBuf := StringHeap.NewBuf(Size + sizeof(Word)' +
            ');'
          
            '                CopyBuffer(pFetchBlockValue, IntPtr(Integer(Heap' +
            'Buf) + sizeof(Word)), Size);'
          '                Marshal.WriteIntPtr(pValue, HeapBuf);'
          
            '                Marshal.WriteInt16(HeapBuf, SmallInt(Word(Size))' +
            ');'
          '              end;'
          '            dtMemo, dtWideMemo, dtMSXML: begin'
          
            '              Blob := TBlob.Create((Field.SubDataType and dtWide' +
            ') <> 0);'
          '              if Status <> DBSTATUS_S_ISNULL then begin'
          '                pc := pFetchBlockValue;'
          '                if Blob.IsUnicode then'
          
            '                  l := integer(StrLenW(pc)) * integer(sizeof(Wid' +
            'eChar)) // D2005 CLR bug'
          '                else'
          '                  l := StrLen(PAChar(pc));'
          '                if l > 0 then begin'
          '                  Blob.RollbackEnabled := False;'
          '                  Blob.Write(0, l, pc);'
          '                  Blob.RollbackEnabled := True;'
          '                end;'
          '              end;'
          
            '              Marshal.WriteInt32(pValue, Integer(Blob.GCHandle))' +
            ';'
          '            end;'
          '            dtBlob: begin'
          '              Assert(Field.SubDataType = dtMSUDT);'
          '              Blob := TBlob.Create;'
          '              if Status <> DBSTATUS_S_ISNULL then begin'
          
            '                l := Marshal.ReadInt32(pFetchBlockValue, Field.L' +
            'ength);'
          '                if l > 0 then begin'
          '                  Blob.RollbackEnabled := False;'
          '                  Blob.Write(0, l, pFetchBlockValue);'
          '                  Blob.RollbackEnabled := True;'
          '                end;'
          '              end;'
          
            '              Marshal.WriteInt32(pValue, Integer(Blob.GCHandle))' +
            ';'
          '            end;'
          '            dtVariant: begin'
          '              Obj := TVariantObject.Create;'
          ''
          
            '              TVariantObject(Obj).Value := GetOleVariant(pFetchB' +
            'lockValue);'
          '              OleVarClear(pFetchBlockValue);'
          ''
          '              Marshal.WriteInt32(pValue, Integer(Obj.GCHandle));'
          '            end;'
          '            dtFloat, dtBcd:'
          '              if not GetNull(FieldNum + 1, pRec) then begin'
          '              {$IFDEF CLR}'
          
            '                DBNumeric := TDBNumeric(Marshal.PtrToStructure(p' +
            'FetchBlockValue, TypeOf(TDBNumeric)));'
          '              {$ELSE}'
          '                DBNumeric := TDBNumeric(pFetchBlockValue^);'
          '              {$ENDIF}'
          '                d := DBNumericToDouble(DBNumeric);'
          '                if Field.DataType = dtFloat then'
          
            '                  Marshal.WriteInt64(pValue, BitConverter.Double' +
            'ToInt64Bits(d))'
          '                else begin'
          '                {$IFDEF CLR}'
          '                  d := d * 10000;'
          '                  i64 := Round(d);'
          '                {$ELSE}'
          '                  c := d;'
          '                  i64 := Int64((@c)^);'
          '                {$ENDIF}'
          '                  Marshal.WriteInt64(pValue, i64);'
          '                end;'
          '              end;'
          '            else'
          '              Assert(False);'
          '          end;'
          '          IncFetchBlockOffset(FetchBlockOffset, Field);'
          '          Assert(FetchBlockOffset <= FFetchBlockSize);'
          ''
          '        end;'
          '      end;'
          '      Check(hr, AnalyzeFieldsStatus, pRec);'
          '    end;'
          ''
          '  var'
          '    AccNum: integer;'
          ''
          '  begin'
          '    FetchBlockOffset := 0;'
          
            '    for AccNum := 0 to Length(FFetchAccessorData.AccessorBlocks)' +
            ' - 1 do'
          
            '      if FFetchAccessorData.AccessorBlocks[AccNum].BlockType = a' +
            'bFetchBlock then'
          
            '        FetchExternalAccessorBlock(FFetchAccessorData.AccessorBl' +
            'ocks[AccNum])'
          '      else'
          
            '        FetchPlainAccessorBlock(FFetchAccessorData.AccessorBlock' +
            's[AccNum]);'
          ''
          '    PrepareConvertableFields;'
          '  end;'
          ''
          
            '  procedure CreateBlockStruct(const pHBlock: PBlockHeader; const' +
            ' RowsObtained: UINT);'
          '  var'
          '    pHItem: PItemHeader;'
          '    i: integer;'
          '    ui: UINT;'
          ''
          '  begin'
          '  // Create Items'
          '    pHItem := IntPtr(Integer(pHBlock) + sizeof(TBlockHeader));'
          '    if IntPtr(FirstItem) = nil then'
          '      FirstItem := pHItem;'
          ''
          '    if IntPtr(LastItem) = nil then begin'
          '      LastItem := pHItem;'
          '      pHItem.Order := 0;'
          '    end;'
          ''
          '    for i := 0 to RowsObtained - 1 do begin'
          '      pHItem.Prev := LastItem;'
          '      pHItem.Next := nil;'
          '      pHItem.Block := pHBlock;'
          '      pHItem.Flag := flUsed;'
          '      pHItem.Rollback := nil;'
          '      pHItem.Status := isUnmodified;'
          '      pHItem.UpdateResult := urNone;'
          '      pHItem.FilterResult := fsNotChecked;'
          ''
          '      LastItem.Next := pHItem;'
          ''
          '      if not ServerCursorUsed then'
          '        pHItem.Order := LastItem.Order + 1;'
          ''
          '      LastItem := pHItem;'
          ''
          '      UpdateCachedBuffer(pHItem, pHItem);'
          ''
          
            '      pHItem := IntPtr(Integer(pHItem) + sizeof(TItemHeader) + R' +
            'ecordSize);'
          '    end;'
          ''
          '    FirstItem.Prev := nil;'
          '    LastItem.Next := nil;'
          ''
          '    case FCursorType of'
          '      ctDefaultResultSet:'
          '        if Filtered and not FFetchAll then'
          
            '          InitFetchedItems(IntPtr(Integer(pHBlock) + sizeof(TBlo' +
            'ckHeader)), False, FetchBack)'
          '        else'
          '          Inc(FRecordCount, RowsObtained);'
          '      ctStatic, ctKeySet:'
          '      begin'
          '        if FBookmarkOffset = - 1 then'
          
            '          FBookmarkOffset := sizeof(TBlockHeader) + sizeof(TItem' +
            'Header) + Fields[Fields.Count - 1].Offset;'
          
            '        LastItem.Order := Marshal.ReadInt32(IntPtr(pHBlock), FBo' +
            'okmarkOffset);'
          '        FBookmarkValue := LastItem.Order;'
          '      end;'
          '      ctDynamic:;'
          '      ctBaseTable:'
          '        if not FUniDirectional then begin'
          '          if Filtered and not FFetchAll then'
          
            '            InitFetchedItems(IntPtr(Integer(pHBlock) + sizeof(TB' +
            'lockHeader)), False, FetchBack)'
          '          else'
          '            Inc(FRecordCount, RowsObtained);'
          '        end;'
          '    end;'
          '      '
          '  // Free items'
          '    ui := UINT(FFetchRows) - RowsObtained;'
          '    if ui > 0 then'
          '      for i := 0 to ui - 1 do begin'
          '        pHItem.Prev := nil;'
          '        pHItem.Next := BlockMan.FirstFree;'
          '        pHItem.Block := pHBlock;'
          '        pHItem.Flag := flFree;'
          '        pHItem.Rollback := nil;'
          ''
          '        if IntPtr(BlockMan.FirstFree) <> nil then'
          '          BlockMan.FirstFree.Prev := pHItem;'
          '        BlockMan.FirstFree := pHItem;'
          ''
          
            '        pHItem := IntPtr(Integer(pHItem) + sizeof(TItemHeader) +' +
            ' RecordSize);'
          '      end;'
          ''
          '    pHBlock.UsedItems := RowsObtained;'
          '  end;'
          ''
          '  procedure InitBlock(pHBlock: PBlockHeader);'
          '  var'
          '    i, j: integer;'
          '    Ptr: IntPtr;'
          '    Field: TFieldDesc;'
          '  begin'
          '    if not HasComplexFields then'
          '      Exit;'
          ''
          '  // Create complex filds'
          '    for i := 0 to FFetchRows - 1 do begin'
          
            '      Ptr := IntPtr(Integer(pHBlock) + sizeof(TBlockHeader) + i ' +
            '* (RecordSize + sizeof(TItemHeader)) + sizeof(TItemHeader));'
          ''
          
            '      /// We does not need to call CreateComplexFields(Ptr, True' +
            ') because (in difference with ODAC) we fetch BLOB(IStream) IntPt' +
            'rs directly to RecBuf'
          '      for j := 0 to FieldCount - 1 do begin'
          '        Field := Fields[j];'
          '        if Field.FieldDescKind <> fdkCalculated then'
          '          case Field.DataType of'
          
            '            dtBlob, dtMemo, dtWideMemo, dtMSXML,  dtVariant, dtE' +
            'xtString, dtExtWideString, dtExtVarBytes:'
          '              Marshal.WriteIntPtr(Ptr, Field.Offset, nil);'
          '          end;'
          '      end;'
          '    end;'
          '  end;'
          ''
          '  procedure ClearBlock(pHBlock: PBlockHeader);'
          '  var'
          '    i: integer;'
          '    Free: PItemHeader;'
          '  begin'
          '    if IntPtr(pHBlock) = nil then'
          '      Exit;'
          ''
          '    // Free complex filds'
          '    Free := IntPtr(Integer(pHBlock) + sizeof(TBlockHeader));'
          '    for i := 1 to pHBlock.ItemCount do begin'
          '      if HasComplexFields and (Free.Flag <> flFree) then'
          
            '        FreeComplexFields(IntPtr(Integer(Free) + sizeof(TItemHea' +
            'der)), True);'
          
            '      Free := IntPtr(Integer(Free) + sizeof(TItemHeader) + Recor' +
            'dSize);'
          '    end;'
          '  end;'
          ''
          
            '  function GetRowsFromOLEDB(var RowsObtained: UINT; prghRows: PU' +
            'intArray): HResult;'
          '  var'
          '    RowsOffset, RowsRequested: integer;'
          '  {$IFDEF CLR}'
          '    p: IntPtr;'
          '  {$ENDIF}'
          '  begin'
          '    // Backward fetch processing'
          '    if FetchBack then'
          '      RowsRequested := - FFetchRows'
          '    else'
          '      RowsRequested := FFetchRows;'
          ''
          '    RowsOffset := 0;'
          ''
          '    // Get data from OLEDB'
          '    if (FCursorType in [ctKeyset, ctStatic]) then begin'
          '      if not FFetchFromBookmark then'
          '        if FetchBack then'
          '          RowsOffset := - 1'
          '        else'
          '          RowsOffset := + 1;'
          ''
          '      Assert(FIRowsetLocate <> nil);'
          
            '      /// FIRowsetLocate.GetRowsAt does not change current IRows' +
            'et fetch position'
          ''
          '    {$IFDEF CLR}'
          '      p := Marshal.AllocHGlobal(SizeOf(Integer));'
          '      try'
          '        Marshal.WriteInt32(p, FBookmarkValue);'
          
            '        Result := FIRowsetLocate.GetRowsAt(0, DB_NULL_HCHAPTER, ' +
            'FBookmarkSize, p, RowsOffset, RowsRequested, RowsObtained, prghR' +
            'ows);'
          '      finally'
          '        Marshal.FreeHGlobal(p);'
          '      end;'
          '    {$ELSE}'
          
            '      Result := FIRowsetLocate.GetRowsAt(0, DB_NULL_HCHAPTER, FB' +
            'ookmarkSize, @FBookmarkValue, RowsOffset, RowsRequested, RowsObt' +
            'ained, prghRows);'
          '    {$ENDIF}'
          '    end'
          '    else'
          '    begin'
          '      if (FCursorType in [ctDynamic, ctBaseTable]) then begin'
          '        if FLastFetchOK then begin'
          
            '          if FFetchFromBookmark then begin // Reread previous re' +
            'aded row'
          '            if FLastFetchBack = FetchBack then begin'
          '              if FetchBack then'
          '                RowsOffset := + 1'
          '              else'
          '                RowsOffset := - 1;'
          '            end;'
          '          end'
          '          else'
          '            if FLastFetchBack <> FetchBack then'
          '              if FetchBack then'
          '                RowsOffset := - 1'
          '              else'
          '                RowsOffset := + 1;'
          '        end'
          '        else'
          '          if FLastFetchBack = FetchBack then'
          '            if FetchBack then'
          '              RowsOffset := + 1'
          '            else'
          '              RowsOffset := - 1;'
          '       end;'
          ''
          
            '      Result := FIRowset.GetNextRows(DB_NULL_HCHAPTER, RowsOffse' +
            't, RowsRequested, RowsObtained, prghRows);'
          '    end;'
          '    FLastFetchBack := FetchBack;'
          
            '    FFetchFromBookmark := False; // Clear flag, setted on Intern' +
            'alOpen'
          '  end;'
          ''
          '  procedure ProcessNoResult;'
          '  begin'
          '    case FCursorType of'
          '      ctDefaultResultSet:'
          '        ReleaseAllInterfaces(False); // Process parameters'
          '      ctStatic:'
          '      begin'
          
            '        Assert(not FFetchFromBookmark, '#39'Cannot fetch to bookmark' +
            ' with Static cursor type'#39');'
          
            '        if not OldFetchFromBookmark {to prevent recursion on emp' +
            'ty resultset} then'
          '          FetchToBookmarkValue;'
          '      end;'
          '      ctKeySet:'
          '      begin'
          '        if FCursorUpdate then'
          
            '          Assert(not FFetchFromBookmark, '#39'Cannot fetch to bookma' +
            'rk with KeySet cursor type'#39');'
          '{        else'
          '          FBookmarkValue := - 1;}'
          '      end;'
          '      ctDynamic:'
          '      begin'
          
            '        CurrentItem := nil; // FHRow is not accessible and we ne' +
            'ed to refetch data from server'
          ''
          '        if not FProcessDynBofEof then begin'
          '          try'
          '            FProcessDynBofEof := True;'
          '            if FetchBack then begin'
          '              FBof := True;'
          ''
          
            '              // Server cursor position is under first row, FHRo' +
            'w is not accessible'
          
            '              // Need to call GetNextRows with params (RowsOffse' +
            't = 1, RowsRequested = - 1)'
          '              FLastFetchOK := True;'
          '              if not FetchToBookmarkValue(True) then'
          '                FEof := True;'
          '            end'
          '            else'
          '            begin'
          '              FEof := True;'
          ''
          
            '              // Server cursor position is below last row, FHRow' +
            ' is not accessible'
          
            '              // Need to call GetNextRows with params (RowsOffse' +
            't = - 1, RowsRequested = 1)'
          '              FLastFetchOK := True;'
          '              if not FetchToBookmarkValue then '
          '                FBof := True;'
          '            end;'
          ''
          '            if not FLastFetchOK then begin'
          '              FLastFetchOK := True;'
          '              FLastFetchBack := False;'
          '            end;'
          '          finally'
          '            FProcessDynBofEof := False;'
          '          end;'
          ''
          '          if FBof or FEof then'
          '            CurrentItem := nil;'
          '        end;'
          '      end;'
          '      ctBaseTable:'
          '      begin'
          '        if FUniDirectional then begin'
          '          CurrentItem := nil;'
          '          FEof := True;'
          '        end'
          '        else'
          '          ReleaseAllInterfaces(False);'
          '      end;'
          '    end;'
          '  end;'
          ''
          '  procedure FirstFetch;'
          '  var'
          '    Field: TOLEDBFieldDesc;'
          '    i: integer;'
          '  begin'
          '    // This is a first call to Fetch.'
          '    // Query interfaces, create accessors etc'
          ''
          '    Assert(FCommand.GetCursorState >= csExecuted);'
          '    if FCommand.GetCursorState = csExecuted then'
          '      FCommand.SetCursorState(csFetching);'
          ''
          '    QueryRecordSetInterfaces;'
          '    AllocFetchBlock;'
          ''
          '    if FCursorType in [ctStatic, ctKeySet] then begin'
          '      // Setting FRecordCount for ctStatic, ctKeySet'
          '      SetToEnd;'
          '      if IntPtr(LastItem) <> nil then begin'
          '        FRecordCount := LastItem.Order;'
          '        SetToBegin;'
          '      end;'
          
            '      FFetchFromBookmark := FCursorType in [ctKeyset, ctStatic];' +
            ' /// First record reading without offsetting'
          '    end;'
          '    FBookmarkValue := DBBMK_FIRST;'
          '    FBookmarkSize := sizeof(FBookmarkValue);'
          ''
          '    // Clear MaxTimestamp for RefreshQuick'
          '    for i := 0 to Fields.Count - 1 do begin'
          '      Field := TOLEDBFieldDesc(Fields[i]);'
          '      if Field.IsTimestamp and (Field.TableInfo <> nil) then'
          '        TOLEDBTableInfo(Field.TableInfo).FMaxTimestamp := 0;'
          '    end;'
          '  end;'
          ''
          'var'
          '  pHBlock: PBlockHeader;'
          '  NewBlock: boolean;'
          ''
          '  hr: HResult;'
          '  RowsObtained: UINT;'
          '  rghRows: TUintArray;'
          '  prghRows: PUintArray;'
          '  GCHandle: IntPtr;'
          ''
          '  i: integer;'
          '  pRec, pData: IntPtr;'
          ''
          '  Cancel: boolean;'
          ''
          '  IsThisFirstFetch: boolean;'
          '  InThread: boolean;'
          'begin'
          '  Result := False;'
          '  Assert(FCommand <> nil);'
          '  if FCommand.GetCursorState in [csFetched, csInactive] then'
          '    Exit;'
          ''
          '{$IFDEF CLR}'
          
            '  InThread := FCommand.FNonBlocking and (FFetchExecutor <> nil) ' +
            'and (Thread.CurrentThread = FFetchExecutor.Thread.Handle);'
          '{$ELSE}'
          
            '  InThread := FCommand.FNonBlocking and (FFetchExecutor <> nil) ' +
            'and (GetCurrentThreadId = FFetchExecutor.Thread.ThreadID);'
          '{$ENDIF}'
          '  try'
          '    if Fields.Count = 0 then'
          
            '      DatabaseError(SNoResultSet, nil); /// Warning - constant S' +
            'NoResultSet used for detecting in TCustomMSDataSet.OpenNext'
          ''
          '    IsThisFirstFetch :='
          '      ((FCommand.FIUnknown <> nil) or not FNativeRowset)'
          '       and (Length(FFetchAccessorData.AccessorBlocks) = 0);'
          '    try'
          '      if IsThisFirstFetch then'
          
            '        FirstFetch; // This is a first call to Fetch. FIUnknown ' +
            'tested for prevent recreating accessors after fetching all strin' +
            'gs'
          ''
          '      DoBeforeFetch(Cancel);'
          ''
          '      if Cancel or FWaitForFetchBreak then begin'
          
            '        if FCommand.GetCursorState in [csFetching, csFetchingAll' +
            '] then'
          '          FCommand.SetCursorState(csFetched);'
          '        Exit;'
          '      end;'
          ''
          '      if FIRowset = nil then'
          '      begin'
          '        Result := False;'
          '        Exit;'
          '      end;'
          ''
          
            '      if (FCursorType = ctKeySet) and not FCursorUpdate and (FBo' +
            'okmarkValue = - 1) then'
          '      begin'
          '        Result := False;'
          '        Exit;'
          '      end;'
          ''
          '      OldFetchFromBookmark := FFetchFromBookmark;'
          ''
          '       // Clear previous obtained rows'
          '      ClearHRowIfNeed;'
          '      Assert(not FHRowAccessible);'
          ''
          '      pHBlock := nil;'
          '      GCHandle := nil;'
          '      prghRows := nil;'
          '      RowsObtained := 0;'
          '      SetLength(rghRows, FFetchRows);'
          '      try'
          '        // Get next rows'
          '        GCHandle := AllocGCHandle(rghRows, True);'
          '        prghRows := GetAddrOfPinnedObject(GCHandle);'
          '        // prghRows := @rghRows[0];'
          '        if FLastFetchEnd then'
          '          RowsObtained := 0'
          '        else'
          '        begin'
          '          hr := GetRowsFromOLEDB(RowsObtained, prghRows);'
          
            '          FLastFetchEnd := ((FNativeRowset and (FCursorType = ct' +
            'DefaultResultSet)) or (FCursorType = ctBaseTable)) and (hr = DB_' +
            'S_ENDOFROWSET); // CR10007'
          ''
          '          // Process rows'
          '          if (hr <> DB_S_ENDOFROWSET)'
          '            and (hr <> DB_S_ROWLIMITEXCEEDED)'
          
            '            and not ((hr = DB_E_BADBOOKMARK) and (FBookmarkValue' +
            ' = DBBMK_FIRST))'
          
            '            and not ((hr = DB_E_BADSTARTPOSITION) and (ProviderP' +
            'rimaryVer = 7))then'
          '            Check(hr);'
          '        end;'
          '        if RowsObtained > 0 then begin'
          
            '          NewBlock := (IntPtr(BlockMan.FirstBlock) = nil) or (no' +
            't FUniDirectional and not (FCursorType in ServerCursorTypes));'
          '          if NewBlock then'
          '            BlockMan.AllocBlock(pHBlock, FFetchRows)'
          '          else begin'
          '            pHBlock := BlockMan.FirstBlock;'
          '            // Refresh block: drop values of blobs'
          '            ClearBlock(pHBlock);'
          '          end;'
          '          InitBlock(pHBlock);'
          
            '          pRec := IntPtr(Integer(pHBlock) + sizeof(TBlockHeader)' +
            ' + sizeof(TItemHeader));'
          '          for i := 0 to RowsObtained - 1 do'
          '          begin'
          
            '            pData := IntPtr(Integer(pRec) + i * (RecordSize + si' +
            'zeof(TItemHeader)));'
          '            GetDataFromRow(rghRows[i], pData);'
          '          end;'
          '        end;'
          '      finally'
          '        FreeGCHandle(GCHandle);'
          '        if RowsObtained > 0 then begin'
          '          // Release row handle(s) if need'
          '          if ServerCursorUsed then begin'
          '            Assert(RowsObtained = 1);'
          '            FHRow := rghRows[0];'
          '            FHRowAccessible := True;'
          '          end'
          '          else'
          
            '            Check(FIRowset.ReleaseRows(RowsObtained, prghRows, n' +
            'il, nil, nil));'
          '        end;'
          ''
          '        if Length(rghRows) <> 0 then'
          '          SetLength(rghRows, 0);'
          '      end;'
          '      Result := RowsObtained > 0;'
          '      FLastFetchOK := Result;'
          ''
          '      if IntPtr(pHBlock) <> nil then begin'
          '        if Result then'
          '          CreateBlockStruct(pHBlock, RowsObtained)'
          '        else'
          '          BlockMan.FreeBlock(pHBlock);'
          '      end;'
          ''
          
            '      if (FNativeRowset or (FCursorType = ctBaseTable)) and (not' +
            ' Result or FLastFetchEnd) then'
          '        ProcessNoResult;'
          ''
          
            '      Assert(not (FCursorType in [ctDynamic]{ServerCursorTypes})' +
            ' or FProcessDynBofEof or (FHRowAccessible or (FBOF and FEOF)), '#39 +
            'Row must be accessible after Fetch for non-empty dataset with se' +
            'rver cursor'#39');'
          '    except'
          '      on e: exception do begin'
          '        if FetchBack then'
          '          FBOF := True'
          '        else'
          '          FEOF := True;'
          ''
          '        ClearBlock(pHBlock);'
          '        FreeFetchBlock;'
          '        ReleaseRecordSetInterfaces;'
          ''
          '        raise;'
          '      end;'
          '    end;'
          '  finally'
          '    if Assigned(FOnAfterFetch) then'
          '      if InThread and FAfterFetch then'
          '        FFetchExecutor.Thread.SendEvent(TObject(FE_AFTERFETCH))'
          '      else'
          '        DoAfterFetch;'
          '  end;'
          'end;'
          ''
          ''
          'end.')
        ScrollBars = ssBoth
        TabOrder = 0
        WordWrap = False
      end
      object mmo2: TMemo
        Left = 0
        Top = 180
        Width = 445
        Height = 267
        Align = alClient
        BorderStyle = bsNone
        Lines.Strings = (
          'mmo1')
        ScrollBars = ssBoth
        TabOrder = 1
        WordWrap = False
      end
    end
  end
end
